home *** CD-ROM | disk | FTP | other *** search
/ SPACE 1 / SPACE - Library 1 - Volume 1.iso / utilitys / 9 / soldidst.bas < prev    next >
Encoding:
BASIC Source File  |  1986-04-03  |  11.6 KB  |  243 lines
  1. 100   ' SOLID STATES FROM ANALOG ISSUE #16
  2. 110   ' CONVERTED TO ST BASIC BY JIM LUCZAK
  3. 120   ' For complete instructions see ANALOG issues # 16,19 and 22
  4. 130   ' To enter your own parameters use option K
  5. 140   ' To enter a data file with pre-entered parameters use option F
  6. 150   ' Good settings for SHIP.DAT
  7. 160   ' OBSERVER LOC.         LOOKED AT          ZOOM
  8. 170   ' 60,-60,40             0,0,0              1
  9. 180   ' 0,-45,6               0,0,0              1
  10. 190   ' 1,0,150               0,0,0              2
  11. 200   ' Good settings for TIEFIGHT.DAT
  12. 210   ' 100,173,50            0,0,0              4
  13. 220   ' 100,200,100           0,0,0              4
  14. 230   ' 100,200,100           0,10,0             4
  15. 232   ' Good settings for XWING.DAT
  16. 234   ' 0,0,100               30,25,5            .5
  17. 236   ' 0,20,50               30,25,10           .5
  18. 238   ' 50,80,30              20,40,10           .5
  19. 240   ' ---------------------- SEE WHAT REZ WE ARE -----------------------------
  20. 250   if peek(systab)=4 then xr=319:yb=199:tx=5:ty=2:tc=4:md=20 '  LOW
  21. 260   if peek(systab)=2 then xr=639:yb=199:tx=23:ty=2:tc=2:md=35 ' MEDIUM
  22. 270   if peek(systab)=1 then xr=639:yb=399:tx=40:ty=4:tc=1:md=35 ' HIGH
  23. 280   ' ------------------ CLEAR SCREEN WRITE TITLE PAGE -----------------------
  24. 290   fullw 2:clearw 2
  25. 300   ' -------------------------SET FILL COLOR INDEX --------------------------
  26. 310   poke contrl,25
  27. 320   poke contrl+2,0
  28. 330   poke contrl+6,1
  29. 340   poke intin,tc ' COLOR INDEX 0-15 LOW  0-3 MED  0-1 HIGH
  30. 350   vdisys(1)
  31. 360   ' ------------------------ SET FILL INTERIOR STYLE -----------------------
  32. 370   poke contrl,23
  33. 380   poke contrl+2,0
  34. 390   poke contrl+6,1
  35. 400   poke intin,2 '  0=HOLLOW  1=SOLID  2=PATTERN  3=HATCH  4=USER DEFINED
  36. 410   vdisys(1)
  37. 420   ' ------------------------ SET FILL STYLE INDEX --------------------------
  38. 430   poke contrl,24
  39. 440   poke contrl+2,0
  40. 450   poke contrl+6,1
  41. 460   poke intin,4 ' 1-24 FOR PATTERN  1-12 FOR HATCH
  42. 470   vdisys(1)
  43. 480   ' -------------------- DRAW ROUNDED FILLED RECTANGLE ---------------------
  44. 490   poke contrl,11
  45. 500   poke contrl+2,3
  46. 510   poke contrl+6,0
  47. 520   poke contrl+10,9 ' PRIMITIVE ID  8=ROUNDED RECT.  9=FILLED ROUNDED RECT.
  48. 530   poke ptsin,xr-md '   X COORD OF LOWER RIGHT CORNER
  49. 540   poke ptsin+2,yb-15 ' Y COORD OF LOWER RIGHT CORNER
  50. 550   poke ptsin+4,5 '     X COORD OF UPPER LEFT CORNER
  51. 560   poke ptsin+6,25'     Y COORD OF UPPER LEFT CORNER
  52. 570   vdisys(1)
  53. 580   ' ------------------------- SET WRITING MODE ---------------------------- 
  54. 590   poke contrl,32
  55. 600   poke contrl+2,0
  56. 610   poke contrl+6,1
  57. 620   poke intin,2 '  1=REPLACE  2=TRANSPARENT  3=XOR  4=REVERSE TRANSPARENT
  58. 630   vdisys(1)
  59. 640   tse=9:gosub SETEFFECTS
  60. 650   gotoxy tx+4,ty:?"** SOLID STATES **"
  61. 660   tse=0:gosub SETEFFECTS
  62. 670   gotoxy tx,ty+4:?"A 3D OBJECT PLOTTING SYSTEM"
  63. 680   gotoxy tx,ty+6:?"ANALOG ISSUES 16, 19, and 22"
  64. 690   tse=4:gosub SETEFFECTS
  65. 700   gotoxy tx-5,ty+8:?"Converted to ST BASIC by JAMES LUCZAK"
  66. 710   tse=16:gosub SETEFFECTS
  67. 720   gotoxy tx,ty+10:?"READ REM'S FOR INSTRUCTIONS"
  68. 730   tse=0:gosub SETEFFECTS
  69. 740   gotoxy tx,16:?"PRESS ANY KEY TO CONTINUE":input a$:clearw 2
  70. 750   ' -------------------- INIT AND PROGRAM START ----------------------------
  71. 760   xl=0:yt=0
  72. 770   a$="F":gosub HILITE:?"ile or ";:a$="K"
  73. 780   gosub HILITE:?"eyboard input ";:input a$
  74. 790   if a$="f" or a$="F" then goto LODEFILE
  75. 800   if a$<>"k" and a$<>"K" then 780
  76. 810   ' --------------------- ENTER DATA FROM KEYBOARD -------------------------
  77. 820   ?:?"How many ";:a$="POINTS":gosub HILITE:?" are there ";:input ps
  78. 830   dim x(ps),y(ps),z(ps),p(ps,2),vis(ps)
  79. 840   ?"Enter ";:a$="X,Y,Z":gosub HILITE:?" coordinates for each point"
  80. 850   for i=1 to ps:? "Point ";i;" ";:input x(i),y(i),z(i):next i
  81. 860   ?"How many ";:a$="LINES":gosub HILITE:?" are there ";:input ls:dim ln(ls,1)
  82. 870   ?"Now enter ";:a$="POINT":gosub HILITE:?" information for each line"
  83. 880   for i=1 to ls:?"LINE ";i:a$="FROM POINT ":gosub HILITE:input ln(i,0)
  84. 890   a$="  TO POINT ":gosub HILITE:input ln(i,1):next i
  85. 900   a$="Y/N ":?"Do you want to save this object ";:gosub HILITE:input a$
  86. 910   if a$="y" or a$="A" then goto SAVEFILE
  87. 920   if a$<>"n" and a$<>"N" then 900
  88. 930   ' --------------------- TIME FOR NEW PLOT ------------------------------
  89. 940   a$="E":gosub HILITE:?"dit  ";:a$="Q":gosub HILITE:?"uit  ";
  90. 950   a$="C":gosub HILITE:?"ontinue ";:input a$
  91. 960   if a$="e" or a$="E" then 1700
  92. 970   if a$="q" or a$="Q" then end
  93. 980   ' ---------------------- ENTER VIEWING PARAMETERS ------------------------
  94. 990   ?:?"Enter observer location ";:a$="X,Y,Z ":gosub HILITE
  95. 1000  zoom=1
  96. 1010  input ox,oy,oz
  97. 1020  ?:?"Enter coordinates looked at ";:a$="X,Y,Z ":gosub HILITE
  98. 1030  input vx,vy,vz
  99. 1040  ?:?"Enter ";:a$="ZOOM ":gosub HILITE:?"factor "
  100. 1050  input zoom
  101. 1060  d0=1:x(0)=vx:y(0)=vy:z(0)=vz
  102. 1070  ' ----------------------CALCULATE PERSPECTIVE --------------------------
  103. 1080  dx=vx-ox:dy=vy-oy:dz=vz-oz
  104. 1090  u1=sqr(dx*dx+dy*dy+dz*dz):if u1=0 then u1=.000001
  105. 1100  cx=dx/u1:cy=dy/u1:cz=dz/u1
  106. 1110  s3=sqr(1-cz*cz):s2=sqr(1-cy*cy)
  107. 1120  qx=ox+d0*cx:qy=oy+d0*cy:qz=oz+d0*cz
  108. 1130  for i=0 to ps:xw=x(i):yw=y(i):zw=z(i):gosub POINTVIS:next i
  109. 1140  for i=0 to ps:if vis(i)=0 then 1160
  110. 1150  xw=x(i):yw=y(i):zw=z(i):gosub POINTVIS:gosub CALCOORD
  111. 1160  next i:goto SCALEIMAGE
  112. 1170  ' -------------------- IS THE POINT VISIBLE ----------------------------
  113. 1180  POINTVIS: vis(i)=1:vcx=xw-ox:vcy=yw-oy:vcz=zw-oz
  114. 1190  if dx*vcx+dy*vcy+dz*vcz>0 then return
  115. 1200  vis(i)=0:return
  116. 1210  ' ---------------- NOW CALCULATE PLOT COORDINATES -----------------------
  117. 1220  CALCOORD: k=d0/(vcx*cx+vcy*cy+vcz*cz)
  118. 1230  ax=ox+k*vcx:ay=oy+k*vcy:az=oz+k*vcz
  119. 1240  if s3=0 then 1270
  120. 1250  p(i,1)=((ax-qx)*cy-(ay-qy)*cx)/s3
  121. 1260  p(i,2)=(az-qz)/s3:return
  122. 1270  p(i,1)=((qx-ax)*cz+(az-qz)*cx)/s2
  123. 1280  p(i,2)=(ay-qy)/s2:return
  124. 1290  ' ------------------------ SCALE THE IMAGE -----------------------------
  125. 1300  SCALEIMAGE: t=450*zoom:for i=0 to ps
  126. 1310  p(i,1)=p(i,1)*t
  127. 1320  p(i,2)=p(i,2)*t
  128. 1330  next i
  129. 1340  xad=(xr/2) -p(0,1):yad=(yb/2)-p(0,2):for i=1 to ps:p(i,1)=p(i,1)+xad
  130. 1350  p(i,2)=p(i,2)+yad:next i
  131. 1360  ' -------------------- NOW DRAW THE IMAGE -----------------------------
  132. 1370  clearw 2:color 1,0,1
  133. 1380  for i=1 to ls:tv=vis(ln(i,0))+vis(ln(i,1)):if tv=0 then 1510
  134. 1390  if tv=2 then 1490
  135. 1400  qt=0:isave=i:if vis(ln(i,0))=0 then i1=ln(i,0):i2=ln(i,1):i=ln(i,0):goto 1420
  136. 1410  i1=ln(i,1):i2=ln(i,0):i=ln(i,1)
  137. 1420  xt1=x(i1):yt1=y(i1):zt1=z(i1):xt2=x(i2):yt2=y(i2):zt2=z(i2):fv=0:fh=0
  138. 1430  xw=(xt1+xt2)/2:yw=(yt1+yt2)/2:zw=(zt1+zt2)/2:gosub POINTVIS
  139. 1440  if vis(i)>0 then xt2=xw:yt2=yw:zt2=zw:goto 1460
  140. 1450  xt1=xw:yt1=yw:zt1=zw
  141. 1460  qt=qt+1:if qt<15 then 1430
  142. 1470  xw=xt2:yw=yt2:zw=zt2:gosub POINTVIS
  143. 1480  gosub CALCOORD:p(i,1)=p(i,1)*t+xad:p(i,2)=p(i,2)*t+yad:vis(i)=0:i=isave
  144. 1490  x1=p(ln(i,0),1):y1=yb-p(ln(i,0),2):x2=p(ln(i,1),1):y2=yb-p(ln(i,1),2)
  145. 1500  gosub GRCLIP
  146. 1510  next i
  147. 1520  for x=15 to 0 step -1:sound 1,x,12,7,1:next x
  148. 1530  color 2,0,1:input"PRESS any key to continue ",a$:color 1,0,1
  149. 1540  clearw 2:?"Last parameters:"
  150. 1550  ?:?"OBSERVER: ";ox;",";oy;",";oz:?"VIEWPOINT: ";vx;",";vy;",";vz:?"ZOOM: ";                                                                               zoom:goto 930
  151. 1560  ' ----------------------- LOAD 3-D IMAGE FILE ---------------------------
  152. 1570  LODEFILE: close 1:?"Enter ";:a$="FILENAME":gosub HILITE:?" to load ";
  153. 1580  input f$:open "I",1,f$
  154. 1590  input#1,ps:dim x(ps),y(ps),z(ps),p(ps,2),vis(ps)
  155. 1600  for x=1 to ps:input#1,x(x),y(x),z(x):next x
  156. 1610  input#1,ls:dim ln(ls,1)
  157. 1620  for x=1 to ls:input#1,ln(x,0),ln(x,1):next x
  158. 1630  close 1: goto 930
  159. 1640  ' ----------------------- SAVE 3-D IMAGE FILE ----------------------------
  160. 1650  SAVEFILE: close 1:?"Enter ";:a$="FILENAME":gosub HILITE:?" to save ";
  161. 1660  input f$:open "O",1,f$
  162. 1670  write #1,ps
  163. 1680  for x=1 to ps:write #1,x(x),y(x),z(x):next x
  164. 1690  write #1,ls:for x=1 to ls:write #1,ln(x,0),ln(x,1):next x:goto 1630
  165. 1700  ' ---------------------- EDIT 3-D IMAGE FILE ----------------------------
  166. 1710  ?:a$="E":gosub HILITE:?"dit ";:a$="P":gosub HILITE:?"rint or ";:a$="Q"
  167. 1720  gosub HILITE:?"uit ";:input a$
  168. 1730  if a$="e" or a$="E" then 1800
  169. 1740  if a$="q" or a$="Q" then 930
  170. 1750  if a$<>"p" and a$<>"P" then 1700
  171. 1760  lprint"POINTS:";ps:lprint
  172. 1770  for x=1 to ps:lprint"POINT ";x;": ";x(x),y(x),z(x):next x:lprint
  173. 1780  lprint"LINES:";ls:lprint
  174. 1790  for x=1 to ls:lprint"LINE ";x;": ";ln(x,0);" To ";ln(x,1):next x:lprint:goto 1700
  175. 1800  ?:?"Edit ";:a$="P":gosub HILITE:?"oint or ";:a$="L":gosub HILITE:?"ine or ";
  176. 1810  a$="Q":gosub HILITE:?"uit ";:input a$:if a$="l" or a$="L" then 1900
  177. 1820  if a$="q" or a$="Q" then 900
  178. 1830  if a$<>"p" and a$<>"P" then 1800
  179. 1840  ?:a$="POINT":gosub HILITE:?"# or ";:a$="RETURN ":gosub HILITE
  180. 1850  input pt$:if pt$="" then 1800
  181. 1860  pt=val(pt$):if pt>ps or pt <0 then 1840
  182. 1870  ?:?"x=";x(pt),"y=";y(pt),"z=";z(pt)
  183. 1880  ?:?"Enter new ";:a$="X Y Z ":gosub HILITE
  184. 1890  input x(pt),y(pt),z(pt):goto 1800
  185. 1900  ?:?"Enter ";:a$="LINE":gosub HILITE:?"# or ";:a$="RETURN":gosub HILITE
  186. 1910  input ln$:if ln$="" then 1800
  187. 1920  ln=val(ln$):if ln>ls or ln<0 then 1900
  188. 1930  ?:?"From POINT:";ln(ln,0);:?"  To POINT:";ln(ln,1)
  189. 1940  ?:?"Enter new LINE POINTS "
  190. 1950  a$="From POINT ":gosub HILITE:input q1:if q1>ps then 1950
  191. 1960  ln(ln,0)=q1
  192. 1970  a$="  To POINT ":gosub HILITE:input q1:if q1>ps then 1970
  193. 1980  ln(ln,1)=q1:goto 1800
  194. 1990  ' ------------------- GRAPHICS CLIP ROUTINE -----------------------------
  195. 2000  GRCLIP:
  196. 2010  l1=0:l2=0:r1=0:r2=0:t1=0:t2=0:b1=0:b2=0
  197. 2020  if x1<xl then l1=1:goto 2040
  198. 2030  if x1>xr then r1=1
  199. 2040  if y1>yb then b1=1:goto 2060
  200. 2050  if y1<yt then t1=1
  201. 2060  if x2<xl then l2=1:goto 2080
  202. 2070  if x2>xr then r2=1
  203. 2080  if y2>yb then b2=1:goto 2100
  204. 2090  if y2<yt then t2=1
  205. 2100  if l1+l2=2 or r1+r2=2 or t1+t2=2 or b1+b2=2 then return
  206. 2110  x3=x1:y3=y1:x4=x2:y4=y2:gosub 2160
  207. 2120  l1=l2:r1=r2:t1=t2:b1=b2
  208. 2130  x1=xw:y1=yw:x3=x2:y3=y2:x4=x1:y4=y1:gosub 2160
  209. 2140  if x1<xl or x1>xr or y1<yt or y1>yb or xw<xl or xw>xr or yw<yt or yw>yb then return
  210. 2150  linef x1,y1,xw,yw:return
  211. 2160  if l1+t1+b1+r1=0 then xw=x3:yw=y3:return
  212. 2170  if l1 then xw=xl:yw=y3+(y4-y3)*(xl-x3)/(x4-x3):x3=xw:y3=yw
  213. 2180  if y3>=yt and y3<=yb then return
  214. 2190  if r1 then xw=xr:yw=y3+(y4-y3)*(xr-x3)/(x4-x3):x3=xw:y3=yw
  215. 2200  if y3>=yt and y3<=yb then return
  216. 2210  if b1 then yw=yb:xw=x3+(x4-x3)*(yb-y3)/(y4-y3):x3=xw:y3=yw
  217. 2220  if x3>=xr and x3<=xl then return
  218. 2230  if t1 then yw=yt:xw=x3=(x4-x3)*(yt-y3)/(y4-y3):x3=xw:y3=yw
  219. 2240  return
  220. 2250  HILITE:
  221. 2260  color 2,0,1:?a$;:color 1,0,0:a$="":return
  222. 2270  ' -------------------- SET TEXT SPECIAL EFFECTS -------------------------
  223. 2280  SETEFFECTS:
  224. 2290  poke contrl,106
  225. 2300  poke contrl+2,0
  226. 2310  poke contrl+6,1
  227. 2320  poke intin,tse '  SETS SPECIAL EFFECT
  228. 2330  vdisys(1)
  229. 2340  return
  230. 2350  ' Special effects attributes are contained in a SIX BIT WORD.
  231. 2360  ' BIT 0 = THICKENED    ( binary value=1 )
  232. 2370  ' BIT 1 = INTENSITY    ( binary value=2 )
  233. 2380  ' BIT 2 = SKEWED       ( binary value=4 )
  234. 2390  ' BIT 3 = UNDERLINED   ( binary value=8 ) 
  235. 2400  ' BIT 4 = OUTLINED     ( binary value=16 )
  236. 2410  ' BIT 5 = SHADOWED     ( binary value = 32 )
  237. 2420  ' To have THICKENED text poke intin in line 2320 to 1
  238. 2430  ' To have UNDERLINED text poke intin to 8
  239. 2440  ' To have UNDERLINED LIGHT INTENSITY text poke intin to 10
  240. 2450  ' You can set any combination of special effects.
  241. 2460  ' Setting the bit activates the special effect.
  242. 2470  ' Resetting the bit deactivates the special effect.
  243. ə4444444444444444444444444444444444444444444444444444444444444444444444444444